Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue69/System/DesktopManager.pas

Pascal/Delphi Source File | 2001-03-17 | 8.0 KB | 233 lines

unit DesktopManager;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  EDesktopManager = class (Exception);

  TDesktopManager = class(TComponent)
  private
    { Private declarations }
    fActive: Boolean;                           // true if injected
    fResponse: PChar;                           // response buffer
    fDeskWin: hWnd;                             // handle of DLL's dialog window
    fAppWindow: hWnd;                           // our window for receiving DLL messages
    fGotResponse: Integer;                      // simple response flag to spin on
    fDummyInteger: Integer;                     // for dummy property writes
    procedure SetActive (Value: Boolean);
    function GetItemCount: Integer;
    function GetColor (Index: Integer): TColorRef;
    procedure SetColor (Index: Integer; Value: TColorRef);
    function GetCaption (Index: Integer): String;
    function GetPosition (Index: Integer): TPoint;
    procedure SetCaption (Index: Integer; const Value: String);
    procedure SetPosition (Index: Integer; Value: TPoint);
    function GetBoundingRectangle (Index: Integer): TRect;
    function PendOnDeskTopMessage (Msg, wParam, lParam: Integer): PChar;
  protected
    { Protected declarations }
    procedure RedrawItems (Forced: Boolean);
    procedure RedrawSingleItem (Index: Integer);
    procedure NeedActive;
    procedure ReceiverHook (var Msg: TMessage); virtual;
  public
    { Public declarations }
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    property Caption [Index: Integer]: String read GetCaption write SetCaption;
    property Position [Index: Integer]: TPoint read GetPosition write SetPosition;
    property BoundingRectangle [Index: Integer]: TRect read GetBoundingRectangle;
  published
    { Published declarations }
    property Active: Boolean read fActive write SetActive default False;
    property ItemCount: Integer read GetItemCount write fDummyInteger stored False;
    property TextColor: TColorRef index 0 read GetColor write SetColor stored False;
    property BackgroundColor: TColorRef index 1 read GetColor write SetColor stored False;
  end;

procedure Register;

implementation

uses CommCtrl, DeskManMessages;

// Interface to DeskManager.DLL

function DeskManagerLoad (AppWindow: hWnd): Bool; stdcall; external 'DeskManager.dll';
function DeskManagerUnload: Bool; stdcall; external 'DeskManager.dll';
function DeskManagerListView: HWnd; stdcall; external 'DeskManager.dll';
function DeskManagerShellThread: DWord; stdcall; external 'DeskManager.dll';

constructor TDesktopManager.Create (AOwner: TComponent);
begin
    Inherited Create (AOwner);
    fAppWindow := AllocateHWnd (ReceiverHook);
end;

destructor TDesktopManager.Destroy;
begin
    // Bow out gracefully...
    SetActive (False);
    DeallocateHWnd (fAppWindow);
    ReallocMem (fResponse, 0);
    Inherited Destroy;
end;

procedure TDesktopManager.ReceiverHook (var Msg: TMessage);
var
    Message: TWMCopyData absolute Msg;
begin
    if (Message.Msg = wm_CopyData) and (Message.From = fDeskWin) then with Message, Message.CopyDataStruct^ do begin
        ReallocMem (fResponse, cbData);
        Move (lpData^, fResponse^, cbData);
        fGotResponse := dwData;
        Result := Integer (True);
    end else Msg.Result := DefWindowProc (fAppWindow, Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TDesktopManager.PendOnDeskTopMessage (Msg, wParam, lParam: Integer): PChar;
begin
    fGotResponse := -1;
    PostMessage (fDeskWin, Msg, wParam, lParam);
    while fGotResponse <> Msg do Application.ProcessMessages;
    Result := fResponse;
end;

procedure TDesktopManager.RedrawSingleItem (Index: Integer);
begin
    SetPosition (Index, GetPosition (Index));  // Think about it...
end;

procedure TDesktopManager.RedrawItems (Forced: Boolean);
begin
    if Forced then begin
        ShowWindow (DeskManagerListView, sw_Hide);
        ShowWindow (DeskManagerListView, sw_ShowNormal);
    end else begin
        SendMessage (DeskManagerListView, lvm_RedrawItems, 0, GetItemCount - 1);
        UpdateWindow (DeskManagerListView);
    end;
end;

procedure TDesktopManager.NeedActive;
begin
    if not fActive then
        raise EDesktopManager.Create ('Desktop Manager is not active');
end;

procedure TDesktopManager.SetActive (Value: Boolean);
var
    Msg: TMsg;
begin
    if fActive <> Value then begin
        if Value then begin
            if FindWindow (Nil, 'Delphi Desktop 2001') <> 0 then raise EDesktopManager.Create ('Another instance of ' + ClassName + ' is already active.') else begin
                DeskManagerLoad (fAppWindow);
                GetMessage (Msg, fAppWindow, DM_DLLReady, DM_DLLReady);
                fDeskWin := FindWindow (Nil, 'Delphi Desktop 2001');
                if fDeskWin = 0 then raise EDesktopManager.Create ('DLL initialization failed');
                fActive := True;
            end;
        end else begin
            SendMessage (fDeskWin, wm_Close, 0, 0);
            while IsWindow (fDeskWin) do Application.ProcessMessages;
            DeskManagerUnload;
            fActive := False;
        end;
    end;
end;

function TDesktopManager.GetItemCount: Integer;
begin
    Result := ListView_GetItemCount (DeskManagerListView);
end;

function TDesktopManager.GetColor (Index: Integer): TColorRef;
begin
    Result := 0;
    case Index of
        0:  Result := ListView_GetTextColor (DeskManagerListView);
        1:  Result := ListView_GetTextBkColor (DeskManagerListView);
    end;
end;

procedure TDesktopManager.SetColor (Index: Integer; Value: TColorRef);
begin
    if GetColor (Index) <> Value then begin
        case Index of
            0:  ListView_SetTextColor (DeskManagerListView, Value);
            1:  ListView_SetTextBkColor (DeskManagerListView, Value);
        end;

        RedrawItems ((Value = CLR_None) and (Index = 1));
    end;
end;

function TDesktopManager.GetCaption (Index: Integer): String;
begin
    NeedActive;
    if (Index < 0) or (Index >= GetItemCount) then Result := '' else
        Result := StrPas (PendOnDesktopMessage (DM_GetItemText, Index, 0));
end;

procedure TDesktopManager.SetCaption (Index: Integer; const Value: String);
var
    cds: TCopyDataStruct;
    buff: array [0..255] of Char;
    Idx: Integer absolute buff;
begin
    NeedActive;
    if (Index >= 0) and (Index < GetItemCount) then begin
        Idx := Index;
        StrPCopy (@buff [sizeof (Integer)], Value);
        cds.dwData := DM_SetItemText;
        cds.cbData := Length (Value) + 1 + sizeof (Integer);
        cds.lpData := @buff;
        SendMessage (fDeskWin, WM_CopyData, fAppWindow, Integer (@cds));
        RedrawSingleItem (Index);
    end;
end;

function TDesktopManager.GetBoundingRectangle (Index: Integer): TRect;
begin
    NeedActive;
    if (Index < 0) or (Index >= GetItemCount) then SetRectEmpty (Result) else
        Result := PRect (PendOnDesktopMessage (DM_GetItemRect, Index, 0))^;
end;

function TDesktopManager.GetPosition (Index: Integer): TPoint;
begin
    NeedActive;
    if (Index < 0) or (Index >= GetItemCount) then Result := Point (-1, -1) else
        Result := PPoint (PendOnDesktopMessage (DM_GetItemPosition, Index, 0))^;
end;

procedure TDesktopManager.SetPosition (Index: Integer; Value: TPoint);
var
    r: TRect;
begin
    NeedActive;
    if (Index >= 0) and (Index < GetItemCount) then begin
        r := GetBoundingRectangle (Index);
        ListView_SetItemPosition (DeskManagerListView, Index, -1000, -1000);
        InvalidateRect (DeskManagerListView, @r, True);
        UpdateWindow (DeskManagerListView);
        ListView_SetItemPosition (DeskManagerListView, Index, Value.x, Value.y);
        r := GetBoundingRectangle (Index);
        InvalidateRect (DeskManagerListView, @r, True);
        UpdateWindow (DeskManagerListView);
    end;
end;

procedure Register;
begin
    RegisterComponents('Delphi Magazine', [TDesktopManager]);
end;

end.